#network library
require(visNetwork, quietly = TRUE)
package 㤼㸱visNetwork㤼㸲 was built under R version 3.4.4
library(reshape)
package 㤼㸱reshape㤼㸲 was built under R version 3.4.4
Attaching package: 㤼㸱reshape㤼㸲

The following object is masked from 㤼㸱package:dplyr㤼㸲:

    rename
#we created a mirrored matrix, so we need to clean part of it (lower triangle), otherwise we´ll have duplicated values
new_matrix <- (Product_Matrix)
new_matrix[lower.tri(new_matrix)] <- NA
#View(new_matrix)
#create nodes and edges
nodes <- data.frame(id=colnames(Product_Matrix)[1:ncol(Product_Matrix)])
edges <- (melt(as.matrix(new_matrix)))
colnames(edges) <- c("from","to","value")
#View(nodes)
#View(edges)
#format edges$value to number
edges$value <- as.numeric(edges$value)
#delete NA values
edges <- edges[((!is.na(edges$value)) & edges$value>0),]
nodes$label <- nodes$id
edges$label <- edges$value
net_graph <- visNetwork(nodes, edges,height = "700px", width = "100%") %>%
  visIgraphLayout() %>%
  visNodes(size = 30) %>%
  visOptions(highlightNearest = TRUE,
             nodesIdSelection = TRUE) %>%
  visInteraction(keyboard = TRUE,
                 dragNodes = T, 
                 dragView = T, 
                 zoomView = T)
#view network graph
net_graph
#save network graph in html file
htmlwidgets::saveWidget(net_graph, "net_graph.html")
#matrix bargraph
barplot(Product_Matrix,beside=TRUE, legend=TRUE) 

library(plotly)
Carregando pacotes exigidos: ggplot2
package 㤼㸱ggplot2㤼㸲 was built under R version 3.4.4Want to understand how all the pieces fit together? See the R for Data Science book:
http://r4ds.had.co.nz/

Attaching package: 㤼㸱plotly㤼㸲

The following object is masked from 㤼㸱package:ggplot2㤼㸲:

    last_plot

The following object is masked from 㤼㸱package:reshape㤼㸲:

    rename

The following object is masked from 㤼㸱package:stats㤼㸲:

    filter

The following object is masked from 㤼㸱package:graphics㤼㸲:

    layout
#create a new data frame, to rank the frequency from edges dataframe
df_rank <- edges
#create a new column 'Description' joining columns 'From' and 'To'
df_rank$Description <- ifelse(df_rank$from != df_rank$to, paste(df_rank$from, df_rank$to, sep = " + "), as.character(df_rank$from))
#order dataframe by value
df_rank <- df_rank[order(-df_rank$value),]
#top 10 values
if (nrow(df_rank)>=10){
  df_rank_10 <- df_rank[1:10,]
}else{
  df_rank_10 <- df_rank
}
plot_ly(data = df_rank_10,
     x = ~Description,
     y = ~value,
     type = "bar"
) %>%
layout(
     title = "Frequency rank of product combinations",
     xaxis = list(title = "",
                  categoryorder = "array",
                  categoryarray = ~value,
                  tickangle=-45),
     yaxis = list(title = "Sum of occurrences"),
     margin = list(b = 200)
)
#heatmap
library(plotly)
 
data=as.matrix(Product_Matrix)
hm1 <- plot_ly(x=colnames(data), y=rownames(data), z = data, type = "heatmap")
 
# with normalization
data=apply(data, 2, function(x){x/mean(x)})
plot_ly(x=colnames(data), y=rownames(data), z = data, type = "heatmap")
#save network graph in html file
htmlwidgets::saveWidget(hm1, "heatmap1.html")
#export result
write.csv(df_rank,"Output/rank-combinations.csv")
library(ggplot2)
df_hm <- df_rank[,(1:3)]
ggplot(data = df_hm, aes(x=from, y=to, fill=value)) + 
  geom_tile()

#correlation of occurrences
cormat <- round(cor(Product_Matrix),2)
head(cormat)
        Pants Shoes Socks t-shirt
Pants    1.00 -0.17  0.82   -0.58
Shoes   -0.17  1.00 -0.43    0.90
Socks    0.82 -0.43  1.00   -0.71
t-shirt -0.58  0.90 -0.71    1.00
library(reshape2)

Attaching package: 㤼㸱reshape2㤼㸲

The following objects are masked from 㤼㸱package:reshape㤼㸲:

    colsplit, melt, recast
melted_cormat <- melt(cormat)
head(melted_cormat)
library(ggplot2)
ggplot(data = melted_cormat, aes(x=X1, y=X2, fill=value)) + 
  geom_tile()

LS0tDQp0aXRsZTogIlN0ZXAgMyAtIENyZWF0ZSBhIG5ldHdvcmsgZ3JhcGgvaGVhdG1hcC9iYXJncmFwaCBmcm9tIHNxdWFyZSBtYXRyaXgiDQphdXRob3I6ICJMdWNpYW5vIEZpcnBvIg0KZGF0ZTogJzIwMTktMDEtMjEnDQpvdXRwdXQ6DQogIG1kX2RvY3VtZW50Og0KICAgIHZhcmlhbnQ6IG1hcmtkb3duX2dpdGh1Yg0KICBodG1sX25vdGVib29rOg0KICAgIHRoZW1lOiB1bml0ZWQNCiAgICB0b2M6IHllcw0KICAgIHRvY19kZXB0aDogMw0KLS0tDQoNCg0KYGBge3J9DQojbmV0d29yayBsaWJyYXJ5DQpyZXF1aXJlKHZpc05ldHdvcmssIHF1aWV0bHkgPSBUUlVFKQ0KbGlicmFyeShyZXNoYXBlKQ0KDQojd2UgY3JlYXRlZCBhIG1pcnJvcmVkIG1hdHJpeCwgc28gd2UgbmVlZCB0byBjbGVhbiBwYXJ0IG9mIGl0IChsb3dlciB0cmlhbmdsZSksIG90aGVyd2lzZSB3ZcK0bGwgaGF2ZSBkdXBsaWNhdGVkIHZhbHVlcw0KbmV3X21hdHJpeCA8LSAoUHJvZHVjdF9NYXRyaXgpDQpuZXdfbWF0cml4W2xvd2VyLnRyaShuZXdfbWF0cml4KV0gPC0gTkENCg0KI1ZpZXcobmV3X21hdHJpeCkNCg0KI2NyZWF0ZSBub2RlcyBhbmQgZWRnZXMNCm5vZGVzIDwtIGRhdGEuZnJhbWUoaWQ9Y29sbmFtZXMoUHJvZHVjdF9NYXRyaXgpWzE6bmNvbChQcm9kdWN0X01hdHJpeCldKQ0KZWRnZXMgPC0gKG1lbHQoYXMubWF0cml4KG5ld19tYXRyaXgpKSkNCmNvbG5hbWVzKGVkZ2VzKSA8LSBjKCJmcm9tIiwidG8iLCJ2YWx1ZSIpDQojVmlldyhub2RlcykNCiNWaWV3KGVkZ2VzKQ0KDQojZm9ybWF0IGVkZ2VzJHZhbHVlIHRvIG51bWJlcg0KZWRnZXMkdmFsdWUgPC0gYXMubnVtZXJpYyhlZGdlcyR2YWx1ZSkNCg0KI2RlbGV0ZSBOQSB2YWx1ZXMNCmVkZ2VzIDwtIGVkZ2VzWygoIWlzLm5hKGVkZ2VzJHZhbHVlKSkgJiBlZGdlcyR2YWx1ZT4wKSxdDQoNCg0Kbm9kZXMkbGFiZWwgPC0gbm9kZXMkaWQNCmVkZ2VzJGxhYmVsIDwtIGVkZ2VzJHZhbHVlDQoNCg0KbmV0X2dyYXBoIDwtIHZpc05ldHdvcmsobm9kZXMsIGVkZ2VzLGhlaWdodCA9ICI3MDBweCIsIHdpZHRoID0gIjEwMCUiKSAlPiUNCiAgdmlzSWdyYXBoTGF5b3V0KCkgJT4lDQogIHZpc05vZGVzKHNpemUgPSAzMCkgJT4lDQogIHZpc09wdGlvbnMoaGlnaGxpZ2h0TmVhcmVzdCA9IFRSVUUsDQogICAgICAgICAgICAgbm9kZXNJZFNlbGVjdGlvbiA9IFRSVUUpICU+JQ0KICB2aXNJbnRlcmFjdGlvbihrZXlib2FyZCA9IFRSVUUsDQogICAgICAgICAgICAgICAgIGRyYWdOb2RlcyA9IFQsIA0KICAgICAgICAgICAgICAgICBkcmFnVmlldyA9IFQsIA0KICAgICAgICAgICAgICAgICB6b29tVmlldyA9IFQpDQoNCg0KYGBgDQoNCmBgYHtyfQ0KI3ZpZXcgbmV0d29yayBncmFwaA0KbmV0X2dyYXBoDQpgYGANCg0KYGBge3J9DQojc2F2ZSBuZXR3b3JrIGdyYXBoIGluIGh0bWwgZmlsZQ0KaHRtbHdpZGdldHM6OnNhdmVXaWRnZXQobmV0X2dyYXBoLCAibmV0X2dyYXBoLmh0bWwiKQ0KYGBgDQpgYGB7cn0NCiNtYXRyaXggYmFyZ3JhcGgNCmJhcnBsb3QoUHJvZHVjdF9NYXRyaXgsYmVzaWRlPVRSVUUsIGxlZ2VuZD1UUlVFKSANCmBgYA0KDQpgYGB7cn0NCmxpYnJhcnkocGxvdGx5KQ0KDQojY3JlYXRlIGEgbmV3IGRhdGEgZnJhbWUsIHRvIHJhbmsgdGhlIGZyZXF1ZW5jeSBmcm9tIGVkZ2VzIGRhdGFmcmFtZQ0KDQpkZl9yYW5rIDwtIGVkZ2VzDQoNCiNjcmVhdGUgYSBuZXcgY29sdW1uICdEZXNjcmlwdGlvbicgam9pbmluZyBjb2x1bW5zICdGcm9tJyBhbmQgJ1RvJw0KZGZfcmFuayREZXNjcmlwdGlvbiA8LSBpZmVsc2UoZGZfcmFuayRmcm9tICE9IGRmX3JhbmskdG8sIHBhc3RlKGRmX3JhbmskZnJvbSwgZGZfcmFuayR0bywgc2VwID0gIiArICIpLCBhcy5jaGFyYWN0ZXIoZGZfcmFuayRmcm9tKSkNCg0KI29yZGVyIGRhdGFmcmFtZSBieSB2YWx1ZQ0KZGZfcmFuayA8LSBkZl9yYW5rW29yZGVyKC1kZl9yYW5rJHZhbHVlKSxdDQoNCiN0b3AgMTAgdmFsdWVzDQppZiAobnJvdyhkZl9yYW5rKT49MTApew0KICBkZl9yYW5rXzEwIDwtIGRmX3JhbmtbMToxMCxdDQp9ZWxzZXsNCiAgZGZfcmFua18xMCA8LSBkZl9yYW5rDQp9DQoNCnBsb3RfbHkoZGF0YSA9IGRmX3JhbmtfMTAsDQogICAgIHggPSB+RGVzY3JpcHRpb24sDQogICAgIHkgPSB+dmFsdWUsDQogICAgIHR5cGUgPSAiYmFyIg0KKSAlPiUNCmxheW91dCgNCiAgICAgdGl0bGUgPSAiRnJlcXVlbmN5IHJhbmsgb2YgcHJvZHVjdCBjb21iaW5hdGlvbnMiLA0KICAgICB4YXhpcyA9IGxpc3QodGl0bGUgPSAiIiwNCiAgICAgICAgICAgICAgICAgIGNhdGVnb3J5b3JkZXIgPSAiYXJyYXkiLA0KICAgICAgICAgICAgICAgICAgY2F0ZWdvcnlhcnJheSA9IH52YWx1ZSwNCiAgICAgICAgICAgICAgICAgIHRpY2thbmdsZT0tNDUpLA0KICAgICB5YXhpcyA9IGxpc3QodGl0bGUgPSAiU3VtIG9mIG9jY3VycmVuY2VzIiksDQogICAgIG1hcmdpbiA9IGxpc3QoYiA9IDIwMCkNCikNCg0KYGBgDQoNCmBgYHtyfQ0KI2hlYXRtYXANCg0KbGlicmFyeShwbG90bHkpDQogDQpkYXRhPWFzLm1hdHJpeChQcm9kdWN0X01hdHJpeCkNCg0KaG0xIDwtIHBsb3RfbHkoeD1jb2xuYW1lcyhkYXRhKSwgeT1yb3duYW1lcyhkYXRhKSwgeiA9IGRhdGEsIHR5cGUgPSAiaGVhdG1hcCIpDQogDQojIHdpdGggbm9ybWFsaXphdGlvbg0KZGF0YT1hcHBseShkYXRhLCAyLCBmdW5jdGlvbih4KXt4L21lYW4oeCl9KQ0KcGxvdF9seSh4PWNvbG5hbWVzKGRhdGEpLCB5PXJvd25hbWVzKGRhdGEpLCB6ID0gZGF0YSwgdHlwZSA9ICJoZWF0bWFwIikNCg0KYGBgDQoNCmBgYHtyfQ0KI3NhdmUgbmV0d29yayBncmFwaCBpbiBodG1sIGZpbGUNCmh0bWx3aWRnZXRzOjpzYXZlV2lkZ2V0KGhtMSwgImhlYXRtYXAxLmh0bWwiKQ0KYGBgDQoNCg0KYGBge3J9DQojZXhwb3J0IHJlc3VsdA0Kd3JpdGUuY3N2KGRmX3JhbmssIk91dHB1dC9yYW5rLWNvbWJpbmF0aW9ucy5jc3YiKQ0KDQpgYGANCmBgYHtyfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KDQpkZl9obSA8LSBkZl9yYW5rWywoMTozKV0NCg0KZ2dwbG90KGRhdGEgPSBkZl9obSwgYWVzKHg9ZnJvbSwgeT10bywgZmlsbD12YWx1ZSkpICsgDQogIGdlb21fdGlsZSgpDQpgYGANCmBgYHtyfQ0KI2NvcnJlbGF0aW9uIG9mIG9jY3VycmVuY2VzDQoNCmNvcm1hdCA8LSByb3VuZChjb3IoUHJvZHVjdF9NYXRyaXgpLDIpDQpoZWFkKGNvcm1hdCkNCg0KbGlicmFyeShyZXNoYXBlMikNCm1lbHRlZF9jb3JtYXQgPC0gbWVsdChjb3JtYXQpDQpoZWFkKG1lbHRlZF9jb3JtYXQpDQoNCmxpYnJhcnkoZ2dwbG90MikNCmdncGxvdChkYXRhID0gbWVsdGVkX2Nvcm1hdCwgYWVzKHg9WDEsIHk9WDIsIGZpbGw9dmFsdWUpKSArIA0KICBnZW9tX3RpbGUoKQ0KDQpgYGANCg0K